home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / os2 / lxlt113.zip / SOURCES / COMMON / HELPERS.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-28  |  10KB  |  318 lines
  1. {$AlignCode-,AlignData-,AlignRec-,G3+,Speed-,Frame-}
  2. Unit Helpers;
  3.  
  4. Interface uses miscUtil;
  5.  
  6. type{ Parameter handling function definition }
  7.       ParmHandleFn = Function(var Parm : string) : Byte;
  8.     { Fast semaphore type }
  9.       tSemaphore   = Longint;
  10.  
  11. {Command line parsing helper. PH gets called on each /# and -# parameter;}
  12. {otherwise NH is called; they return number of chars starting from string}
  13. {start which have to be stripped (i.e. when they were already recognized)}
  14. {If ParmStr is #1 uses the real command line;otherwise ParmStr is used   }
  15.  Procedure ParseCommandLine(const ParmStr : string; PH,NH : ParmHandleFn);
  16.  
  17. {Return TRUE if file exists; FALSE otherwise}
  18.  Function  FileExist(const PathName : string) : Boolean;
  19.  
  20. {Try to rename file sName into dName. Returns TRUE if succesful}
  21.  Function FileRename(const sName,dName : string) : Boolean;
  22.  
  23. {Try to erase file fName and returns TRUE if succesful}
  24.  Function FileErase(const fName : string) : Boolean;
  25.  
  26. {Returns file length in bytes or -1 if no such file}
  27.  Function FileLength(const fName : string) : Longint;
  28.  
  29. {Copy file srcName into dstName; return TRUE if o.k.}
  30.  Function FileCopy(const srcName,dstName : string) : boolean;
  31.  
  32. {Return a string containing executable`s source path including last '\'}
  33.  Function SourcePath : string;
  34.  
  35. {Read EAs from given file into EA dynamic array}
  36.  Function ReadEAs(const fName : string; var EA : pDarray) : boolean;
  37.  
  38. {Append EAs from EA to file fName}
  39.  Function WriteEAs(const fName : string; EA : pDarray) : boolean;
  40.  
  41. {Free EAs in dynamic array and array itself}
  42.  Procedure FreeEAs(var EA : pDarray);
  43.  
  44. { A very FAST semaphore realization; 32 semaphores (0-31) in one variable }
  45.  Procedure fsInit(var Sem : tSemaphore);
  46.  Procedure fsRelease(var Sem : tSemaphore; semNo : Byte);
  47.  Procedure fsRequest(var Sem : tSemaphore; semNo : Byte; Sleep : boolean);
  48.  Function  fsCheck(var Sem : tSemaphore; semNo : Byte) : boolean;
  49.  
  50. Implementation uses dos, os2def, os2base, strOp, strings;
  51.  
  52. Procedure ParseCommandLine;
  53. var S : String;
  54. begin
  55.  if ParmStr = #1
  56.   then S := StrPas(GetASCIIZptr(CmdLine^, 2))
  57.   else S := ParmStr;
  58.  While S <> '' do
  59.   begin
  60.    While (S <> '') and ((S[1] = ' ') or (S[1] = #9)) do Delete(S, 1, 1);
  61.    if S <> ''
  62.     then
  63.      if (S[1] in ['/','-'])
  64.       then begin
  65.             Delete(S, 1, 1);
  66.             if (@PH <> NIL) and (S <> '') then Delete(S, 1, PH(S));
  67.            end
  68.       else
  69.      if @NH <> NIL
  70.       then Delete(S, 1, NH(S))
  71.       else Delete(S, 1, 1);
  72.   end;
  73. end;
  74.  
  75. Function FileExist;
  76. var F : File;
  77. begin
  78.  Assign(F, PathName); Reset(F, 1); Close(F);
  79.  FileExist := ioResult = 0;
  80. end;
  81.  
  82. Function FileRename;
  83. var F : File;
  84. begin
  85.  Assign(F, sName); Rename(F, dName);
  86.  FileRename := ioResult = 0;
  87. end;
  88.  
  89. Function FileErase;
  90. var F : File;
  91. begin
  92.  Assign(F, FName); SetFAttr(F, Archive);
  93.  Erase(F); FileErase := ioResult = 0;
  94. end;
  95.  
  96. Function FileLength;
  97. var F : File;
  98.     I : Longint;
  99. begin
  100.  I := FileMode; FileMode := $40;
  101.  Assign(F, fName); Reset(F, 1);
  102.  FileMode := I;
  103.  if ioResult <> 0
  104.   then FileLength := -1
  105.   else begin
  106.         FileLength := FileSize(F);
  107.         Close(F);
  108.        end;
  109. end;
  110.  
  111. Function FileCopy;
  112. var sn,dn : pChar;
  113. begin
  114.  GetMem(sn, succ(length(srcName)));
  115.  GetMem(dn, succ(length(dstName)));
  116.  StrPCopy(sn, srcName);
  117.  StrPCopy(dn, dstName);
  118.  FileCopy := DosCopy(sn, dn, dcpy_Existing) = 0;
  119.  FreeMem(sn, succ(length(srcName)));
  120.  FreeMem(dn, succ(length(dstName)));
  121. end;
  122.  
  123. Function SourcePath; assembler; {$USES esi,edi}
  124. asm             mov     edi,CmdLine
  125.                 mov     al,0
  126.                 mov     ecx,-1
  127.                 repne   scasb
  128. @@searchSlash:  dec     edi
  129.                 cmp     edi,CmdLine
  130.                 jbe     @@done
  131.                 cmp     byte ptr [edi],'\'
  132.                 jne     @@searchSlash
  133. @@done:         mov     esi,CmdLine
  134.                 sub     edi,esi
  135.                 mov     eax,edi
  136.                 inc     eax
  137.                 mov     ecx,eax
  138.                 mov     edi,@result
  139.                 stosb
  140.                 rep     movsb
  141. end; {$USES none}
  142.  
  143. Function ReadEAs(const fName : string; var EA : pDarray) : boolean;
  144. label locEx;
  145. const eaNameBfSz = 1024;
  146.       secureSize = 256; {F$#%^k! Bug in DosEnumAttribute}
  147. var   fN         : pChar;
  148.       sV,oV,
  149.       I,eaCn     : Longint;
  150.       Buff       : pArrOfByte;
  151.       eaN        : pDarray;
  152.       pS         : pString;
  153.       pEA,nEA    : pFea2;
  154.       eaBuf      : EAop2;
  155.       fStat      : FileStatus4;
  156. begin
  157.  ReadEAs := _OFF;
  158.  GetMem(fN, succ(length(fName)));
  159.  GetMem(Buff, eaNameBfSz + secureSize);
  160.  New(eaN, Init(8));
  161.  New(EA, Init(8));
  162.  fillChar(fStat, sizeOf(fStat), 0);
  163.  fillChar(eaBuf, sizeOf(eaBuf), 0);
  164.  if (fN = nil) or (Buff = nil) or (eaN = nil) or (EA = nil) then goto locEx;
  165.  StrPCopy(fN, fName);
  166.  sV := 1;
  167.  repeat
  168.   eaCn := -1; FillChar(Buff^, eaNameBfSz, 0); {F&^#$@%&k! Really not needed}
  169.   if DosEnumAttribute(EnumEA_RefType_Path, fN, sV, Buff^, eaNameBfSz, eaCn, EnumEA_Level_No_Value) <> 0
  170.    then goto locEx;
  171.   if eaCn = 0 then break;
  172.   pEA := @Buff^;
  173.   For I := 1 to eaCn do
  174.    begin
  175.     eaN^.AddItem(NewStr(StrPas(@pEA^.szName)));
  176.     Inc(Longint(pEA), pEA^.oNextEntryOffset);
  177.     Inc(sV);
  178.    end;
  179.  until _OFF;
  180.  if DosQueryPathInfo(fN, Fil_QueryEAsize, fStat, sizeOf(fStat)) <> 0 then goto locEx;
  181.  I := 1;
  182.  GetMem(eaBuf.fpFEA2List, fStat.cbList);
  183.  eaBuf.fpGEA2List := @Buff^;
  184.  While I <= eaN^.numItems do
  185.   begin
  186.    sV := 4; oV := 4;
  187.    repeat
  188.     pS := eaN^.GetItem(I);
  189.     if sV + 4 + succ(length(pS^)) > pred(eaNameBfSz) then break;
  190.     pLong(@Buff^[oV])^ := sV - oV;
  191.     pLong(@Buff^[sV])^ := 0; oV := sV;
  192.     Move(pS^, Buff^[sV + 4], succ(length(pS^)));
  193.     Inc(sV, 4 + succ(length(pS^)));
  194.     Buff^[sV] := 0; sV := (sV + 4) and $FFFFFFFC;
  195.     Inc(I);
  196.    until I > eaN^.numItems;
  197.    pLong(@Buff^[0])^ := sV;
  198.    eaBuf.fpFEA2List^.cbList := fStat.cbList;
  199.    if DosQueryPathInfo(fN, Fil_QueryEAsFromList, eaBuf, sizeOf(eaBuf)) = 0
  200.     then begin
  201.           pEA := @eaBuf.fpFEA2List^.list;
  202.           While longint(pEA) - longint(@eaBuf.fpFEA2List^.list) <= eaBuf.fpFEA2List^.cbList do
  203.            begin
  204.             GetMem(nEA, sizeOf(Fea2) + pEA^.cbName + pEA^.cbValue);
  205.             Move(pEA^, nEA^, sizeOf(Fea2) + pEA^.cbName + pEA^.cbValue);
  206.             EA^.AddItem(nEA);
  207.             if pEA^.oNextEntryOffset = 0 then break;
  208.             Inc(longint(pEA), pEA^.oNextEntryOffset);
  209.            end;
  210.          end;
  211.   end;
  212.  ReadEAs := _ON;
  213. locEx:
  214.  if eaBuf.fpFEA2List <> nil
  215.   then FreeMem(eaBuf.fpFEA2List, fStat.cbList);
  216.  if eaN <> nil
  217.   then begin
  218.         For I := 1 to eaN^.numItems do DisposeStr(eaN^.GetItem(I));
  219.         Dispose(eaN, done);
  220.        end;
  221.  if Buff <> nil then FreeMem(Buff, eaNameBfSz + secureSize);
  222.  if fN <> nil then FreeMem(fN, succ(length(fName)));
  223. end;
  224.  
  225. Function WriteEAs(const fName : string; EA : pDarray) : boolean;
  226. label locEx;
  227. const eaNameBfSz = 300;
  228. var   fN         : pChar;
  229.       I,maxEA    : Longint;
  230.       eaBuf      : EAop2;
  231.       Buff,OneEA : pArrOfByte;
  232. begin
  233.  WriteEAs := _OFF;
  234.  GetMem(fN, succ(length(fName)));
  235.  GetMem(Buff, eaNameBfSz);
  236.  maxEA := 0;
  237.  if (fN = nil) or (Buff = nil) then goto locEx;
  238.  StrPCopy(fN, fName);
  239.  For I := 1 to EA^.numItems do
  240.   with pFea2(EA^.GetItem(I))^ do
  241.    if sizeOf(Fea2) + cbName + cbValue > maxEA
  242.     then maxEA := sizeOf(Fea2) + cbName + cbValue;
  243.  Inc(maxEA, 4);
  244.  GetMem(oneEA, maxEA);
  245.  pLong(oneEA)^ := maxEA;
  246.  eaBuf.fpGEA2List := @Buff^;
  247.  eaBuf.fpFEA2list := @oneEA^;
  248.  For I := 1 to EA^.numItems do
  249.   with pFea2(EA^.GetItem(I))^ do
  250.    begin
  251.     oNextEntryOffset := 0;
  252.     pLong(@Buff^[0])^ := 4 + 4 + 1 + 1 + cbName;
  253.     pLong(@Buff^[4])^ := 0;
  254.     Buff^[8] := cbName;
  255.     Move(szName, Buff^[9], cbName);
  256.     Buff^[9 + cbName] := 0;
  257.     Move(oNextEntryOffset, oneEA^[4], sizeOf(Fea2) + cbName + cbValue);
  258.     DosSetPathInfo(fN, Fil_QueryEAsize, eaBuf, sizeOf(eaBuf), 0);
  259.    end;
  260.  WriteEAs := _ON;
  261. locEx:
  262.  FreeMem(oneEA, maxEA);
  263.  if Buff <> nil then FreeMem(Buff, eaNameBfSz);
  264.  if fN <> nil then FreeMem(fN, succ(length(fName)));
  265. end;
  266.  
  267. Procedure FreeEAs(var EA : pDarray);
  268. var I : Longint;
  269. begin
  270.  if EA <> nil
  271.   then begin
  272.         For I := 1 to EA^.numItems do
  273.          with pFea2(EA^.GetItem(I))^ do
  274.           FreeMem(@oNextEntryOffset, sizeOf(Fea2) + cbName + cbValue);
  275.         Dispose(EA, Done);
  276.        end;
  277. end;
  278.  
  279. Procedure fsInit; assembler;
  280. {$frame-} {$uses none} {$saves ebx,ecx,edx,esi,edi}
  281. asm             mov     eax,Sem
  282.                 mov     dword ptr [eax],0
  283. end;
  284.  
  285. Procedure fsRelease; assembler;
  286. {$frame-} {$uses none} {$saves ebx,edx,esi,edi}
  287. asm             mov     eax,Sem
  288.                 movzx   ecx,semNo
  289.                 btr     dword ptr [eax],ecx
  290. end;
  291.  
  292. Procedure fsRequest; assembler;
  293. {$frame-} {$uses ebx,esi} {$saves ebx,esi,edi}
  294. asm
  295. @@semCheck:     mov     eax,Sem
  296.                 movzx   ecx,semNo
  297.                 bts     [eax],ecx
  298.                 jnc     @@semFree
  299.                 cmp     Sleep,0
  300.                 je      @@semCheck
  301.                 push    large 0
  302.                 call    DosSleep
  303.                 add     esp,4
  304.                 jmp     @@semCheck
  305. @@semFree:
  306. end;
  307.  
  308. Function fsCheck; assembler;
  309. {$frame-} {$uses none} {$saves ebx,edx,esi,edi}
  310. asm             mov     eax,Sem
  311.                 movzx   ecx,semNo
  312.                 bt      dword ptr [eax],ecx
  313.                 setc    al
  314. end;
  315.  
  316. end.
  317.  
  318.